COMMENT ⊗   VALID 00010 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00005 00002	BEGIN "II"
 00009 00003	⊃	misc. routines
 00011 00004	⊃	output routines
 00013 00005	⊃	storing procedures
 00016 00006	⊃	GENERATE A SET FROM INPUT STRING.
 00018 00007	⊃	special routines to activate drivers
 00020 00008	⊃	SIMPLE RECOGNIZER. VALUE IS DISPATCH NUMBER
 00022 00009	⊃	MAIN PROGRAM BEGINS HERE - INITIALIZE
 00027 00010	⊃	EVALUATION ROUTINE LEAVES PNTR TO RESULT IN INDEX
 00032 ENDMK
⊗;
BEGIN "II"

DEFINE ⊃="COMMENT";

⊃	This is the driver for debugging the hand/eye utility routines;

REQUIRE "HEUTIL.SAI" SOURCE_FILE;

⊃	I_NAME contains all known identifiers.  The are of three types
		special variable (internal table references) no index
		procedure name (index into P_ARG and P_BITS)
		defined variable (defined by user at run time) index to
		constant table
	I_INDEX contains the index, if any, into tables for that data type
	I_TYPE contains the data type as follows:
			-1	special variable
			0	untyped (empty)
		INT	1	integer
		STR	2	string
		ST	3	set
		FP	4	real
	I_IND is the maximum permanent entry used.
	I_TEMP is the maximum temp variable (≥ I_IND)
	SV_IND is the maximum index for special variables
	PRO_IND is the number of procedures defined
	PREDEF_IND is the last compiled in identifier (defined variables
		start immediately thereafter	;

INTEGER I_IND,I_TEMP;
DEFINE SV_IND="7", PRO_IND="16", PREDEF_IND="SV_IND+PRO_IND";
PRELOAD_WITH "ALL","U_BLOB","U_OBJ","U_GUN","U_LINK","STATUS","CAMERA",
	"GETEDGE","CURVE","EDGFIN","GUNNAR","SIMPLE","COMP","REJ_OBJ",
	"JOB_START","INNER","COLGET","DISP_OBJ","CAMCHG","VERIF",
	"DISP_DEL","TAB_SET","MOVE_OBJ";
STRING ARRAY I_NAME[1:50];
PRELOAD_WITH [SV_IND] 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
	15, 16;
INTEGER ARRAY I_INDEX[1:50];
DEFINE INT="1", STR="2", ST="3", FP="4";
PRELOAD_WITH [SV_IND] -1, ST, ST, ST, STR, ST, 0, 0, INT, ST, ST, 0, INT,
	FP, 0, 0, 0;
INTEGER ARRAY I_TYPE[1:50];

PRELOAD_WITH 1,1,1,1,3,1,1,1, 1, 1, 2, 5, 4, 1, 0, 4;
INTEGER ARRAY P_ARG[1:PRO_IND];
PRELOAD_WITH 1,3,3,3,733,3,3,2,3,3,13,44411,1111, 3, 0, 1113;
INTEGER ARRAY P_BITS[1:PRO_IND];

⊃	SET_*, INT_*, FP_*, AND STR_* are for storing constant sets,
		integers, reals, and strings.
	*VAL contains the constant
	*FLG is TRUE if the *VAL entry is in use
	*ind is the maximum entry in use	;

INTEGER SETIND, STRIND, INTIND, FPIND;
SET ARRAY SET_VAL[1:50];
STRING ARRAY STRVAL[1:50];
INTEGER ARRAY INTVAL, INTFLG, STRFLG, FPFLG, SETFLG[1:50];
REAL ARRAY FPVAL[1:50];

⊃	misc. variables ;

INTEGER BRK, STORE, TYPE, INDEX, I, J, K, NARGS, BITS, CNTR, TYP;
INTEGER ARRAY ARGS[1:10];
STRING LINE_IN,IDENT;
LABEL ERROR, PROLAB, L2, L3, ERROR1, ERROR2, ERROUT, LOOP;
DEFINE CRLF="'15&'12";
BOOLEAN FOUND, FPFND;
⊃	misc. routines;

⊃	FIND IDENTIFIER. TRUE IF FOUND. I IS INDEX ON EXIT;

SIMPLE BOOLEAN PROCEDURE FIND_NAM(STRING IDENT; REFERENCE INTEGER I);
	BEGIN
	FOR I←1 STEP 1 UNTIL I_IND DO IF EQU(IDENT,I_NAME[I]) THEN DONE;
	RETURN(I≤I_IND);
	END;

⊃	TRUE IF ARGUMENT IS AN INTEGER OR REAL-FPFND IF TRUE IFF REAL FOUND;

SIMPLE BOOLEAN PROCEDURE INTTST(STRING X);
	BEGIN INTEGER I, L, A;
	FPFND ← FALSE;
	IF ¬(L ← LENGTH(X)) THEN RETURN(FALSE);
	A ← IF X[1 FOR 1]="-" THEN 2 ELSE 1;
	FOR I←A STEP 1 UNTIL L DO
		BEGIN
		A←X[I FOR 1];
		IF A<"0"∨A>"9" THEN IF A="."∧¬FPFND THEN
			FPFND←TRUE ELSE RETURN(FALSE);
		END;
	RETURN(TRUE);
	END;

⊃	MARK THE CONSTANT REFERENCED BY I AS UNUSED;

SIMPLE PROCEDURE FLUSH(INTEGER I);
	BEGIN INTEGER J, K;
	J ← I_TYPE[I];
	K ← I_INDEX[I];
	IF 0<J<5 THEN CASE J-1 OF
		BEGIN
		INTFLG[K] ← FALSE;
		BEGIN STRFLG[K] ← FALSE; STRVAL[K] ← NULL; END;
		BEGIN SETFLG[K] ← FALSE; SET_VAL[K] ← PHI; END;
		FPFLG[K] ← FALSE;
		END;
	I_TYPE[I] ← 0;
	END;
⊃	output routines;

⊃	OUTPUT A REAL NUMBER;

SIMPLE STRING PROCEDURE REALOUT(REAL X);
	BEGIN STRING Y;
	SETFORMAT(20,8);
	Y←CVF(X);
	SETFORMAT(0,0);
	RETURN(Y);
	END;

⊃	OUTPUT A SET;

SIMPLE STRING PROCEDURE OUTSET(SET FOO);
	BEGIN STRING S;
	BOOLEAN FLAG;
	ITEMVAR ARG;
	S ← "{";
	WHILE LENGTH(FOO) DO S ← S&PN(LOP(FOO))&",";
	IF S[∞ FOR 1]="," THEN S←S[1 TO ∞-1];
	RETURN(S&"}");
	END;

⊃	OUTPUT THE VALUE SPECIFIED BY THE INDEX WITH LABEL;

SIMPLE PROCEDURE OUT_VAL(STRING LAB; INTEGER INDEX);
	BEGIN INTEGER I,J;
	OUTSTR(LAB&"="&(IF ¬INDEX∨¬(I←I_INDEX[INDEX])∨¬(J←I_TYPE[INDEX]) THEN
		"*** NO VALUE ***" ELSE CASE J-1 OF
		(CVS(INTVAL[I]),""""&STRVAL[I]&"""",
		OUTSET(SET_VAL[I]),REALOUT(FPVAL[I])))&CRLF);
	END;
⊃	storing procedures;

⊃	STORE THE VALUE IN PROPER TABLE.  RETURNS TABLE INDEX;


SIMPLE INTEGER PROCEDURE STORE_VAL(INTEGER INDEX,VAL; STRING X;
		SET FOO; REAL R);
	BEGIN INTEGER TOP, I;
	IF INDEX<1 THEN RETURN(0) ELSE INDEX ← INDEX-1;
	TOP ← CASE INDEX OF (INTIND, STRIND, SETIND, FPIND);
	FOR I←1 STEP 1 UNTIL TOP DO
		IF ¬(CASE INDEX OF (
			INTFLG[I],
			STRFLG[I],
			SETFLG[I],
			FPFLG[I])) THEN DONE;
	IF I>TOP THEN CASE INDEX OF
		BEGIN
		INTIND ← I;
		STRIND ← I;
		SETIND ← I;
		FPIND ← I;
		END;
	CASE INDEX OF
		BEGIN
		BEGIN INTFLG[I]←TRUE; INTVAL[I]←VAL;END;
		BEGIN STRFLG[I]←TRUE; STRVAL[I]←X;END;
		BEGIN SETFLG[I]←TRUE; SET_VAL[I]←FOO;END;
		BEGIN FPFLG[I]←TRUE; FPVAL[I]←R;END;
		END;
	RETURN(I);
	END;

⊃	STORE AN INTEGER;

SIMPLE PROCEDURE STORE_INT(INTEGER FOO, INDEX);
	BEGIN
	IF INDEX≤I_IND THEN FLUSH(INDEX);
	I_TYPE[INDEX] ← INT;
	I_INDEX[INDEX] ← STORE_VAL(INT,FOO,NULL,PHI,0);
	END;

⊃	STORE A STRING;

SIMPLE PROCEDURE STORE_STR(STRING FOO; INTEGER INDEX);
	BEGIN
	IF INDEX≤I_IND THEN FLUSH(INDEX);
	I_TYPE[INDEX] ← STR;
	I_INDEX[INDEX] ← STORE_VAL(STR,0,FOO,PHI,0);
	END;

⊃	STORE A SET;

SIMPLE PROCEDURE STORE_SET(SET FOO; INTEGER INDEX);
	BEGIN
	IF INDEX≤I_IND THEN FLUSH(INDEX);
	I_TYPE[INDEX] ← ST;
	I_INDEX[INDEX] ← STORE_VAL(ST,0,NULL,FOO,0);
	END;

⊃	STORE A REAL;

SIMPLE PROCEDURE STORE_FP(REAL X; INTEGER INDEX);
	BEGIN
	IF INDEX≤I_IND THEN FLUSH(INDEX);
	I_TYPE[INDEX] ← FP;
	I_INDEX[INDEX] ← STORE_VAL(FP,0,NULL,PHI,X);
	END;
⊃	GENERATE A SET FROM INPUT STRING.
	INITIAL { ALREADY REMOVED.
	RETURN NULL SET IF ANY ERRORS;

SET PROCEDURE MAKE_SET(REFERENCE STRING X);
	BEGIN SET FOO;
	INTEGER BRK, FLAG, B;
	ITEMVAR A;
	STRING L;
	LABEL ERROR;
	FOO ← PHI;
	DO	BEGIN
		L ← SCAN(X,3,BRK);
		IF LENGTH(L) THEN
			BEGIN
			IF INTTST(L) THEN
				BEGIN
				B←CVD(L);
				IF B<0∨B>'7777 THEN GO TO ERROR;
				A ← CVI(B);
				END ELSE BEGIN
				A ← CVSI(L,FLAG);
				IF FLAG THEN
ERROR:					BEGIN
					OUTSTR(L&" NOT AN ITEM"&'12&X&CRLF);
					RETURN(PHI);
					END;
				END;
			PUT A IN FOO;
			END ELSE IF BRK=","∨LENGTH(FOO) THEN
			BEGIN
			OUTSTR("NULL TERM ILLEGAL IN SET"&'12&L&CRLF);
			RETURN(PHI);
			END;
		END UNTIL ¬BRK∨BRK="}";
	IF ¬BRK THEN
		BEGIN
		OUTSTR("SET DID NOT END"&'12&L&CRLF);
		RETURN(PHI);
		END;
	RETURN(FOO);
	END;
⊃	special routines to activate drivers
	which cannot be called directly;

⊃	ACTIVATE NEW_SIMP;

PROCEDURE MOVE_OBJ(SET OBJS; INTEGER DX, DY, DTHETA);
	BEGIN REAL ARRAY F,T[1:4,1:4];
	REQUIRE "SAITRG[1,PDQ]" LOAD_MODULE;
	EXTERNAL REAL PROCEDURE COS(REAL X);
	EXTERNAL REAL PROCEDURE ACOS(REAL X);
	EXTERNAL REAL PROCEDURE SIN(REAL X);
	DEFINE π="3.1415926535";
	REAL ANGLE;
	REAL ARRAY ITEMVAR X;
	FOREACH X|XεOBJS DO
		BEGIN
		ARRTRAN(T,GLOBAL DATUM(X));
		IF DTHETA THEN
			BEGIN INTEGER I,J;
			SAFE REAL ARRAY M[1:4,1:4];
			ANGLE ← π*DTHETA/180.0;
			M[1,1] ← M[2,2] ← COS(ANGLE);
			M[2,1] ← -(M[1,2] ← SIN(ANGLE));
			M[3,3] ← M[4,4] ← 1.0;
			FOR I←1 STEP 1 UNTIL 4 DO FOR J ← 1 STEP 1 UNTIL 4 DO
				BEGIN INTEGER K;
				F[I,J] ← 0;
				FOR K←1 STEP 1 UNTIL 4 DO
					F[I,J] ← F[I,J]+M[I,K]*T[K,J];
				END;
			END ELSE ARRTRAN(F,T);
		F[1,4] ← T[1,4] + DX;
		F[2,4] ← T[2,4] + DY;
		IF ¬NEW_SIMP(X,F) THEN OUTSTR("NEW_SIMP FAILED"&CRLF);
		END;
	END;
⊃	SIMPLE RECOGNIZER. VALUE IS DISPATCH NUMBER
		1	ERROR 1
		2	ERROR 2
		3	PROCEDURE SEEN
		4	OK, INDEX POINTS TO VALUE
	;

SIMPLE INTEGER PROCEDURE DECODE(REFERENCE STRING LINE_IN, IDENT;
		REFERENCE INTEGER BRK, INDEX);
	BEGIN INTEGER I,FOO;
	LABEL L1;
	IF LENGTH(IDENT) THEN
		BEGIN STRING F;
		IF BRK="(" THEN RETURN(3);
		IF INTTST(IDENT) THEN
			BEGIN
			INDEX←I_TEMP←I_TEMP+1;
			IF FPFND THEN STORE_FP(REALSCAN(F←IDENT,FOO),INDEX)
				ELSE STORE_INT(CVD(IDENT),INDEX);
			RETURN(4);
			END;
		IF FIND_NAM(IDENT,INDEX)∧INDEX>PREDEF_IND THEN RETURN(4);
		RETURN(1);
		END;
	IF BRK="""" THEN
		BEGIN
		IDENT ← SCAN(LINE_IN,2,BRK);
		IF BRK="""" THEN STORE_STR(IDENT,INDEX←I_TEMP←I_TEMP+1) ELSE
			BEGIN OUTSTR("STRING DID NOT END");RETURN(2);END;
		GO TO L1;
		END;
	IF BRK="{" THEN
		BEGIN
		STORE_SET(MAKE_SET(LINE_IN),INDEX←I_TEMP←I_TEMP+1);
L1:		IF LENGTH(LINE_IN) THEN
			BEGIN
			BRK ← LINE_IN[1 FOR 1];
			LINE_IN ← IF LENGTH(LINE_IN) THEN LINE_IN[2 TO ∞]
				ELSE NULL;
			END;
		RETURN(4);
		END;
	OUTSTR("UNKNOWN DELIMITER - "&BRK);
	RETURN(2);
	END;
⊃	MAIN PROGRAM BEGINS HERE - INITIALIZE;

I_IND ← PREDEF_IND;
I_TEMP ← SETIND ← STRIND ← INTIND ← FPIND ← 0;
SETBREAK(1,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_"&
	"0123456789 .-"," ","XN");
SETBREAK(2,"""",NULL,"I");
SETBREAK(3,"},",NULL,"I");
U_INIT;
TYP_II ← TRUE;
SETFORMAT(0,0);

⊃	EXECUTION LOOP;

WHILE TRUE DO
	BEGIN "LOOP"
	OUTSTR("*"&CRLF);
	DO LINE_IN ← INCHWL UNTIL LENGTH(LINE_IN);
	STORE ← 0;
	I_TEMP ← I_IND;
	IDENT ← SCAN(LINE_IN,1,BRK);
	IF LENGTH(IDENT) THEN
		BEGIN "NOTNUL"
		FOUND ← FIND_NAM(IDENT, INDEX);
		IF BRK="↓" THEN
			BEGIN "DELETE"
			IF ¬FOUND∨INDEX≤PREDEF_IND THEN
ERROR1:				BEGIN "ERROR1"
				OUTSTR(IDENT&" NOT RECOGNIZED OR ILLEGAL");
				GO TO ERROR2;
				END "ERROR1";
			FLUSH(INDEX);
			I_NAME[INDEX] ← NULL;
			GO TO ERROUT;
			END "DELETE";
		IF BRK="=" THEN
			BEGIN "SPECIAL"
			IF ¬FOUND∨INDEX>SV_IND THEN GO TO ERROR1;
			CASE INDEX-1 OF
				BEGIN

				FOR I←PREDEF_IND+1 STEP 1 UNTIL I_IND DO
					IF LENGTH(I_NAME[I]) THEN
					OUT_VAL(I_NAME[I],I);
				OUTSTR("U_BLOB= "&OUTSET(U_BLOB)&CRLF);
				OUTSTR("U_OBJ= "&OUTSET(U_OBJ)&CRLF);

				BEGIN "U_GUN"
				OUTSTR("FILE  SET"&CRLF&CRLF);
				FOR I←1 STEP 1 UNTIL U_GUNINDEX DO
					IF LENGTH(U_GUNSET[I]) THEN
					OUTSTR(CVS(U_GUNNUM[I])&"   "&
					OUTSET(U_GUNSET[I])&CRLF);
				END "U_GUN";

				BEGIN "U_LINK"
				OUTSTR("BLOB SETS ↔ OBJECT SETS"&CRLF&CRLF);
				FOR I←1 STEP 1 UNTIL U_BOINDEX DO
					IF LENGTH(U_BLOBS[I])∨
					LENGTH(U_OBJS[I]) THEN
					OUTSTR(OUTSET(U_BLOBS[I])&" ↔ "&
						OUTSET(U_OBJS[I])&CRLF);
				END "U_LINK";

				BEGIN "STATUS" INTEGER ITEMVAR B;
				OUTSTR("BLOB        STATUS"&CRLF&CRLF);
				FOREACH B|BεU_BLOB DO
					OUTSTR(PN(B)&" "&CVOS(U_GD(B))&CRLF);
				END "STATUS";

				BEGIN "CAMERA"
				OUTSTR("CAMFLG="&CVS(CAMFLG)&CRLF);
				OUTSTR("CAMPAN="&REALOUT(CAMPAN)&CRLF);
				OUTSTR("CAMTIL="&REALOUT(CAMTIL)&CRLF);
				OUTSTR("CAMRANGE="&REALOUT(CAMRANG)&CRLF);
				OUTSTR("CAMLENS="&CVS(CAMLENS)&CRLF);
				END "CAMERA";

				END;
			GO TO ERROUT;
			END "SPECIAL";
		IF BRK="←" THEN
			BEGIN "ASSIGN"
			IF ¬FOUND THEN
				BEGIN "DEFINE"
				FOR I←PREDEF_IND+1 STEP 1 UNTIL I_IND DO
					IF ¬LENGTH(I_NAME[I]) THEN DONE;
				IF I>I_IND THEN I_TEMP ← I_IND ← I;
				I_NAME[INDEX←I] ← IDENT;
				I_INDEX[I] ← I_TYPE[I] ← 0;
				END "DEFINE" ELSE IF INDEX≤PREDEF_IND THEN
					GO TO ERROR1;
			STORE ← INDEX;
			IF ¬LENGTH(LINE_IN) THEN
				BEGIN
				FLUSH(STORE);
				GO TO ERROUT;
				END;
			IDENT ← SCAN(LINE_IN,1,BRK);
			END "ASSIGN";
		END "NOTNUL";
	INDEX ← 0;
⊃	EVALUATION ROUTINE LEAVES PNTR TO RESULT IN INDEX;

	CASE DECODE(LINE_IN,IDENT,BRK,INDEX)-1 OF
		BEGIN
		GO TO ERROR1;

ERROR2:		BEGIN "ERROR2"
		OUTSTR('12&LINE_IN&CRLF);
		GO TO ERROUT;
		END "ERROR2";

		BEGIN "PROC"
		IF ¬FIND_NAM(IDENT,I) THEN GO TO ERROR1;
		IF ¬(SV_IND<I≤SV_IND+PRO_IND) THEN GO TO ERROR1;
		NARGS ← P_ARG[I_INDEX[I]];
		BITS ← P_BITS[I_INDEX[I]];
		CNTR ← 1;
LOOP:		TYP ← BITS MOD 10;
		BITS ← BITS DIV 10;
		IDENT ← SCAN(LINE_IN,1,BRK);
		IF ¬NARGS THEN IF ¬LENGTH(IDENT)∧BRK=")" THEN GO TO L3
			ELSE GO TO L2;
		CASE DECODE(LINE_IN,IDENT,BRK,J) OF
			BEGIN
			GO TO ERROR1;
			GO TO ERROR2;
			GO TO ERROR2;
			;
			END;
		IF J>I_IND THEN
			BEGIN
			IF TYP>FP THEN
				BEGIN
				OUTSTR("CONTANT FOR CALL BY REFERENCE");
				GO TO ERROR2;
				END;
			END ELSE IF TYP>FP THEN
				BEGIN
				FLUSH(J);
				I_INDEX[J] ← STORE_VAL(TYP-FP,0,NULL,PHI,0);
				I_TYPE[J] ← TYP-FP;
				END;
		IF TYP>FP THEN TYP ← TYP-FP;
		IF I_TYPE[J]≠TYP THEN
			BEGIN
			OUTSTR("ARGUMENT TYPE MISMATCH");
			GO TO ERROR2;
			END;
		ARGS[CNTR] ← J;
		CNTR ← CNTR+1;
		IF CNTR≤NARGS THEN IF BRK="," THEN GO TO LOOP ELSE
			BEGIN
			OUTSTR("<ARGS");
			GO TO ERROR2;
			END ELSE IF BRK≠")" THEN
L2:				BEGIN OUTSTR(">ARGS");GO TO ERROR2;END;
L3:		INDEX ← IF I_TYPE[I-SV_IND] THEN I_TEMP ← I_TEMP+1 ELSE 0;
		CASE I-SV_IND-1 OF
			BEGIN DEFINE G(I)="I_INDEX[ARGS[I]]";
			STORE_SET(GETEDGE(INTVAL[G(1)]),INDEX);
			STORE_SET(CURVE(SET_VAL[G(1)]),INDEX);
			STORE_SET(EDGFIN(SET_VAL[G(1)]),INDEX);
			STORE_STR(GUNNAR(SET_VAL[G(1)]),INDEX);
			STORE_SET(SIMPL(SET_VAL[G(1)],SET_VAL[G(2)],
				SET_VAL[G(3)]),INDEX);
			COMP(SET_VAL[G(1)]);
			BEGIN REJ_OBJ(SET_VAL[G(1)]);FLUSH(ARGS[1]); END;
			STORE_INT(JOB_START(STRVAL[G(1)]),INDEX);
			STORE_SET(INNER(SET_VAL[G(1)]),INDEX);
			STORE_SET(COLGET(SET_VAL[G(1)]),INDEX);
			DISP_OBJ(SET_VAL[G(1)],INTVAL[G(2)]);
			STORE_INT(CAMCHG(INTVAL[G(1)],INTVAL[G(2)],
				FPVAL[G(3)],FPVAL[G(4)],FPVAL[G(5)]),INDEX);
			STORE_FP(VERIF(INTVAL[G(1)],INTVAL[G(2)],
				INTVAL[G(3)],INTVAL[G(4)]),INDEX);
			DISP_DEL(SET_VAL[G(1)]);
			TAB_SET;
			MOVE_OBJ(SET_VAL[G(1)],INTVAL[G(2)],INTVAL[G(3)],
				INTVAL[G(4)]);
			END;
		END "PROC";
		;	⊃ VALUE RETURNED;
		END;

⊃	END OF EVALUATION - OUTPUT RESULT, IF ANY;

	IF STORE THEN IF INDEX THEN
		BEGIN
		I ← I_INDEX[INDEX];
		I_TYPE[STORE] ← I_TYPE[INDEX];
		I_INDEX[STORE] ← STORE_VAL(I_TYPE[INDEX],INTVAL[I],
			STRVAL[I],SET_VAL[I],FPVAL[I]);
		END ELSE FLUSH(STORE) ELSE OUT_VAL(NULL,INDEX);
ERROUT:	FOR I←I_IND+1 STEP 1 UNTIL I_TEMP DO FLUSH(I);
	END "LOOP";

END "II";